home *** CD-ROM | disk | FTP | other *** search
- /* memptr.f -- translated by f2c (version of 3 February 1990 3:36:42).
- You must link the resulting object file with the libraries:
- -lF77 -lI77 -lm -lc (in that order)
- */
-
- #include "f2c.h"
-
- /* Common Block Declarations */
-
- struct {
- doublereal cpyknt;
- integer istack[1], lorg, icore, maxcor, maxuse, memavl, ldval, numblk,
- loctab, ltab, ifwa, nwoff, ntab, maxmem, memerr, nwd4, nwd8,
- nwd16;
- } memmgr_;
-
- #define memmgr_1 memmgr_
-
- /*< logical function memptr(ipntr) >*/
- logical memptr_(ipntr)
- integer *ipntr;
- {
- /* System generated locals */
- integer i_1;
- logical ret_val;
-
- /* Local variables */
- extern integer locf_();
- static integer i, locpnt;
-
- /* Parameter adjustments */
- --ipntr;
-
- /* Function Body */
- /*< implicit double precision (a-h,o-z) >*/
-
- /* this routine checks whether *ipntr* is a valid block pointer. */
- /* if it is valid, *ltab* is set to point to the corresponding entry in */
-
- /* the block table. */
-
- /* ... ipntr is an array to avoid 'call by value' problems (see setmem) */
-
- /*< dimension ipntr(1) >*/
- /* spice version 2g.6 sccsid=memmgr 3/15/83 */
- /*< common /memmgr/ cpyknt,istack(1),lorg,icore,maxcor,maxuse,memavl, >*/
- /*< 1 ldval,numblk,loctab,ltab,ifwa,nwoff,ntab,maxmem,memerr,nwd4, >*/
- /*< 2 nwd8,nwd16 >*/
- /*< memptr=.false. >*/
- ret_val = FALSE_;
- /*< ltab=loctab >*/
- memmgr_1.ltab = memmgr_1.loctab;
- /*< locpnt=locf(ipntr(1)) >*/
- locpnt = locf_(&ipntr[1]);
- /*< do 20 i=1,numblk >*/
- i_1 = memmgr_1.numblk;
- for (i = 1; i <= i_1; ++i) {
- /*< if (locpnt.ne.istack(ltab+4)) go to 10 >*/
- if (locpnt != memmgr_1.istack[memmgr_1.ltab + 3]) {
- goto L10;
- }
- /*< if (ipntr(1)*istack(ltab+5).ne.istack(ltab+1)) go to 10 >*/
- if (ipntr[1] * memmgr_1.istack[memmgr_1.ltab + 4] != memmgr_1.istack[
- memmgr_1.ltab]) {
- goto L10;
- }
- /*< memptr=.true. >*/
- ret_val = TRUE_;
- /*< go to 30 >*/
- goto L30;
- /*< 10 ltab=ltab+ntab >*/
- L10:
- memmgr_1.ltab += memmgr_1.ntab;
- /*< 20 continue >*/
- /* L20: */
- }
- /*< 30 return >*/
- L30:
- return ret_val;
- /*< end >*/
- } /* memptr_ */
-
-